home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Technotools
/
Technotools (Chestnut CD-ROM)(1993).ISO
/
lang_oth
/
fifth21
/
towers.fiv
< prev
next >
Wrap
Text File
|
1986-03-29
|
3KB
|
165 lines
CREATE HANOI
CREATE (N)
EDIT
variable (N)
~UP
CREATE N
EDIT
: N (N) @ ;
~UP
CREATE RING
EDIT
variable ring
12 1+ allot
~UP
CREATE 4DUP
EDIT
: 4DUP stack abcd|abcdabcd ;
~UP
CREATE POS
EDIT
: POS
( location pos -> coordinate )
N N + 1+ * N + ;
~UP
CREATE HALFDISPLAY
EDIT
: HALFDISPLAY
( color size --- )
0 DO DUP EMIT LOOP DROP ;
~UP
CREATE <DISPLAY>
EDIT
: <DISPLAY>
( line color size --- )
stack ab|abab HALFDISPLAY stack abc|bca 3 < IF 32 ELSE 186 ( | )
ENDIF EMIT HALFDISPLAY ;
~UP
CREATE DISPLAY
EDIT
: DISPLAY
( size pos line color --- )
SWAP >R stack abc|caba - R@ ( color size pos-size line )
GOTOXY R> ( color size line ) stack abc|cab <DISPLAY> ;
~UP
CREATE PRESENCE
EDIT
: PRESENCE
( tower ring presence -> boolean )
RING + C@ = negate ;
~UP
CREATE LINE
EDIT
: LINE
( tower line -> display-line-of-top )
4 SWAP N 0 DO DUP I PRESENCE 0= negate stack abc|bca + SWAP LOOP DROP ;
~UP
CREATE RAISE
EDIT
: RAISE
( size tower --- )
DUP POS SWAP LINE 2 SWAP DO
stack ab|abab I 32 DISPLAY stack ab|abab I 1- 205 DISPLAY
-1 +LOOP drop DROP ;
~UP
CREATE LOWER
EDIT
: LOWER
( size tower --- )
DUP POS SWAP LINE 1+ 2 DO
stack ab|abab I 1- 32 DISPLAY stack ab|abab I 205 DISPLAY
LOOP drop DROP ;
~UP
CREATE MOVELEFT
EDIT
: MOVELEFT
( size source.tower destiny.tower --- )
POS SWAP POS 1- DO DUP I 1+ 1 32 DISPLAY
DUP I 1 205 DISPLAY -1 +LOOP DROP ;
~UP
CREATE MOVERIGHT
EDIT
: MOVERIGHT
( size source.tower destiny.tower --- )
POS 1+ SWAP POS 1+ DO DUP I 1- 1 32 DISPLAY
DUP I 1 205 DISPLAY LOOP DROP ;
~UP
CREATE TRAVERSE
EDIT
: TRAVERSE
( size source.tower destiny.tower --- )
stack ab|abab > IF MOVELEFT ELSE MOVERIGHT ENDIF ;
~UP
CREATE MOVE
EDIT
: MOVE
( size source.tower destiny.tower --- )
?TERM if key 32 = not if 0 N 4 + GOTOXY ABORT endif endif
stack abc|cabab RAISE stack abc|abbca TRAVERSE
stack ab|abab RING + 1- C! SWAP LOWER ;
~UP
CREATE MULTIMOV
EDIT
: MULTIMOV
( size source destiny spare --- )
3 PICK 1 = IF DROP MOVE ELSE
stack abcd|bcda 1- stack abcd|dabcdacb MULTIMOV
stack abcd|abcdbca 1+ stack abc|cab MOVE
stack abc|cba MULTIMOV ENDIF ;
~UP
CREATE MAKETOWER
EDIT
: MAKETOWER
( tower --- )
POS 4 N + 3 DO DUP I GOTOXY 186 EMIT LOOP DROP ;
~UP
CREATE MAKEBASE
EDIT
: MAKEBASE
( no arguments )
0 N 4 + GOTOXY N 6 * 3 + 0 DO 177 EMIT LOOP ;
~UP
CREATE MAKERING
EDIT
: MAKERING
( tower size --- )
stack ab|abab RING + 1- C! SWAP LOWER ;
~UP
CREATE SETUP
EDIT
: SETUP ( no arguments )
CLS
N 1+ 0 DO 1 RING I + C! LOOP
3 0 DO I MAKETOWER LOOP
MAKEBASE
1 N DO 0 I MAKERING -1 +LOOP
;
~UP
CREATE TOWERS
EDIT
: TOWERS
( quantity --- )
1 MAX 12 MIN (N) !
SETUP
33 0 GOTOXY ." Fifth"
N 2 0 1
BEGIN
OVER POS N 4 + GOTOXY
stack abcd|acdbacdb MULTIMOV
2 0 do 7 emit loop
0 UNTIL ;
~UP
EDIT
: hanoi
depth 1 < if
cr cr
." Hanoi expects the number of pieces on the stack." cr
." For example, to solve a five piece towers of hanoi " cr
." puzzle, type: " cr cr
." 5 HANOI" cr cr
exit
endif
towers ;
~UP
ABORT